home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / keplerports.mod (.txt) < prev    next >
Oberon Text  |  1995-06-12  |  16KB  |  369 lines
  1. Syntax10.Scn.Fnt
  2. MODULE KeplerPorts; (* J. Templ, 30.10.90/07.06.94 *)
  3.     (* Ports provide device independent drawing operations clipped on the port's borders.
  4.         All drawing and mouse coordinates are relative to the origin x0, y0, which is relative to the
  5.         top left corner of the port. Capital letter coordinates always denote screen coordinates.
  6.     IMPORT
  7.         Display, Display1, Fonts, Printer, TextPrinter;
  8.     CONST
  9.         Ceres = FALSE; (*conditional compilation*)
  10.     TYPE
  11.         Port* = POINTER TO PortDesc;
  12.         PortDesc* = RECORD (Display.FrameDesc)
  13.             x0*, y0*, scale*: INTEGER;
  14.             ext*: Port;
  15.         END ;
  16.         DisplayPort* = POINTER TO DisplayPortDesc;
  17.         DisplayPortDesc* = RECORD (PortDesc) END ;
  18.         PrinterPort* = POINTER TO PrinterPortDesc;
  19.         PrinterPortDesc* = RECORD (PortDesc) END ;
  20.         BalloonPort* = POINTER TO BalloonPortDesc;
  21.         BalloonPortDesc* = RECORD (PortDesc) END ;
  22. (* ----------------- abstract port methods ------------------ *)
  23.     PROCEDURE (P: Port) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  24.     END FillRect;
  25.     PROCEDURE (P: Port) DrawString*(x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  26.     END DrawString;
  27. (* ----------------- concrete port methods ------------------ *)
  28.     PROCEDURE (P: Port) CX*(x: INTEGER): INTEGER;
  29.     BEGIN RETURN P.X + (P.x0 + x) DIV P.scale
  30.     END CX;
  31.     PROCEDURE (P: Port) CY*(y: INTEGER): INTEGER;
  32.     BEGIN RETURN P.Y + P.H + (P.y0 + y) DIV P.scale
  33.     END CY;
  34.     PROCEDURE (P: Port) Cx*(X: INTEGER): INTEGER;
  35.     BEGIN RETURN (X - P.X) * P.scale - P.x0
  36.     END Cx;
  37.     PROCEDURE (P: Port) Cy*(Y: INTEGER): INTEGER;
  38.     BEGIN RETURN (Y - P.Y - P.H) * P.scale - P.y0
  39.     END Cy;
  40.     PROCEDURE (P: Port) DrawLine*(x1, y1, x2, y2, col, mode: INTEGER);
  41.         VAR x, y, dx, dy, d, inc, Xmin, Xmax, Ymin, Ymax: INTEGER;
  42.     BEGIN
  43.         x1 := P.CX(x1); y1 := P.CY(y1); x2 := P.CX(x2); y2 := P.CY(y2);
  44.         IF x1 < x2 THEN Xmin := x1; Xmax := x2 ELSE Xmin := x2; Xmax := x1 END;
  45.         IF y1 < y2 THEN Ymin := y1; Ymax := y2 ELSE Ymin := y2; Ymax := y1 END;
  46.         IF (y2-y1) < (x1-x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  47.         dx := 2*(x2-x1);
  48.         dy := 2*(y2-y1);
  49.         x := x1; y := y1; inc := 1;
  50.         IF dy > dx THEN d := dy DIV 2;
  51.             IF dx < 0 THEN inc := -1; dx := -dx END;
  52.             WHILE y <= y2 DO
  53.                 P.FillRect(P.Cx(x), P.Cy(y), P.scale, P.scale, col, 5, mode);
  54.                 INC(y); DEC(d, dx);
  55.                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  56.             END
  57.         ELSE d := dx DIV 2;
  58.             IF dy < 0 THEN inc := -1; dy := -dy END;
  59.             WHILE x <= x2 DO
  60.                 P.FillRect(P.Cx(x), P.Cy(y), P.scale, P.scale, col, 5, mode);
  61.                 INC(x); DEC(d, dy);
  62.                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  63.             END
  64.         END
  65.     END DrawLine;
  66.     PROCEDURE (P: Port) DrawRect*(x, y, w, h, col, mode: INTEGER);
  67.     BEGIN
  68.         IF P.scale = 1 THEN DEC(x); DEC(y);
  69.             P.FillRect(x,  y, w+3,  3, col, 5, mode);
  70.             P.FillRect(x+w,  y, 3,  h+3, col, 5, mode);
  71.             P.FillRect(x,  y+h, w+3,  3, col, 5, mode);
  72.             P.FillRect(x,  y, 3,  h+3, col, 5, mode)
  73.         ELSE
  74.             P.FillRect(x,  y, w,  P.scale, col, 5, mode);
  75.             P.FillRect(x+w-P.scale,  y, P.scale,  h, col, 5, mode);
  76.             P.FillRect(x,  y+h-P.scale, w,  P.scale, col, 5, mode);
  77.             P.FillRect(x,  y, P.scale,  h, col, 5, mode)
  78.         END
  79.     END DrawRect;
  80.     PROCEDURE HairEllipse (P: Port; X, Y, A, B, col, mode: INTEGER); (* due to B. Stamm *)
  81.         VAR x, y: INTEGER; d, dx, dy, x2, y2, a, a2, a8, b, b2, b8: LONGINT;
  82.         PROCEDURE Dot4(x1, x2, y1, y2, col, mode: INTEGER);
  83.         BEGIN
  84.             P.FillRect(x1, y1, P.scale, P.scale, col, 5, mode);
  85.             P.FillRect(x1, y2, P.scale, P.scale, col, 5, mode);
  86.             P.FillRect(x2, y1, P.scale, P.scale, col, 5, mode);
  87.             P.FillRect(x2, y2, P.scale, P.scale, col, 5, mode);
  88.         END Dot4;
  89.     BEGIN
  90.         IF A = B THEN (* circle *)
  91.             DEC(A);
  92.             x := A; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*A;
  93.             WHILE x > y DO
  94.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  95.                 Dot4(P.Cx(X-y-1), P.Cx(X+y), P.Cy(Y-x-1), P.Cy(Y+x), col, mode);
  96.                 INC(d, dy); INC(dy, 8); INC(y);
  97.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  98.             END;
  99.             IF x = y THEN Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode) END
  100.         ELSIF (A > 0) & (B > 0) THEN (* ellipse *)
  101.             DEC(A); DEC(B);
  102.             a := A; a2 := a*a; a8 := 8*a2; b := B; b2 := b*b; b8 := 8*b2;
  103.             x := A; y := 0; x2 := a*b2; y2 := 0; dx := b8*(a-1); dy := 4*a2; d := b2*(1- 4*a);
  104.             WHILE y2 < x2 DO
  105.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  106.                 INC(d, dy); INC(dy, a8); INC(y); INC(y2, a2);
  107.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x); DEC(x2, b2) END
  108.             END;
  109.             INC(d, 4*(x2+y2)-b2+a2);
  110.             WHILE x >= 0 DO
  111.                 Dot4(P.Cx(X-x-1), P.Cx(X+x), P.Cy(Y-y-1), P.Cy(Y+y), col, mode);
  112.                 DEC(d, dx); DEC(dx, b8); DEC(x);
  113.                 IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y) END
  114.             END
  115.         END
  116.     END HairEllipse;
  117.     PROCEDURE (P: Port) DrawEllipse*(x, y, a, b, col, mode: INTEGER);
  118.     BEGIN HairEllipse(P, P.CX(x), P.CY(y), a DIV P.scale, b DIV P.scale, col, mode)
  119.     END DrawEllipse;
  120.     PROCEDURE (P: Port) DrawCircle*(x, y, r, col, mode: INTEGER);
  121.     BEGIN HairEllipse(P, P.CX(x), P.CY(y), r DIV P.scale, r DIV P.scale, col, mode)
  122.     END DrawCircle;
  123.     PROCEDURE Line2(P: Port; col, pat, mode, x1, x2, y1, y2: INTEGER);
  124.     BEGIN
  125.         x1 := P.Cx(x1); x2 := P.Cx(x2); y1 := P.Cy(y1); y2 := P.Cy(y2);
  126.         P.FillRect(x1, y1, x2-x1, P.scale, col, pat, mode);
  127.         P.FillRect(x1, y2, x2-x1, P.scale, col, pat, mode)
  128.     END Line2;
  129.     PROCEDURE (P: Port) FillCircle* (x, y, r, col, pat, mode: INTEGER);
  130.         VAR x1, y1, d, dx, dy: INTEGER;
  131.     BEGIN x := P.CX(x); y := P.CY(y); r := r DIV P.scale;
  132.         IF (P.X < x + r) & (x - r < P.X + P.W) & (P.Y < y + r) & (y - r < P.Y + P.H) THEN
  133.             x1 := r - 1; y1 := 0; dx := (x1-1)*8; dy := y1*8 + 4; d := 3 - r*4;
  134.             WHILE x1 > y1 DO
  135.                 Line2(P, col, pat, mode, x-x1-1, x+x1, y-y1-1, y+y1);
  136.                 IF d+dy >= 0 THEN Line2(P, col, pat, mode, x-y1-1, x+y1, y-x1-1, y+x1) END ;
  137.                 INC(d, dy); INC(dy, 8); INC(y1);
  138.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x1) END
  139.             END;
  140.             IF x1 = y1 THEN Line2(P, col, pat, mode, x-x1-1, x+x1, y-y1-1, y+y1) END
  141.         END
  142.     END FillCircle;
  143.     PROCEDURE (P: Port) FillQuad* (x1, y1, x2, y2, x3, y3, x4, y4, col, pat, mode: INTEGER);    (* by B. Stamm *)
  144.       TYPE  LineParms = RECORD x,y,d,dx,dy,inx,iny,drawX,drawY: INTEGER END;
  145.       VAR x,y,RHS2,RHS3: INTEGER; left,right: LineParms;
  146.       PROCEDURE InitLineParms(x1,y1,x2,y2: INTEGER; VAR p: LineParms);
  147.       BEGIN
  148.         p.x := x1; p.dx := x2-x1; IF p.dx > 0 THEN p.inx := 1 ELSIF p.dx < 0 THEN p.inx := -1; p.dx := -p.dx ELSE p.inx := 0 END;
  149.         p.y := y1; p.dy := y2-y1; IF p.dy > 0 THEN p.iny := 1 ELSIF p.dy < 0 THEN p.iny := -1; p.dy := -p.dy ELSE p.iny := 0 END;
  150.         p.d := p.dy - p.dx; p.dx := 2*p.dx; p.dy := 2*p.dy;
  151.       END InitLineParms;
  152.       
  153.       PROCEDURE LineStep(VAR p: LineParms);
  154.         (* H = (d(x,y) := (2*x - 2*x1 + 1)*dy - (2*y - 2*y1 + 1)*dx < 0) *)
  155.       BEGIN
  156.         WHILE p.d < 0 DO INC(p.x,p.inx); INC(p.d,p.dy) END;
  157.         p.drawX := p.x; p.drawY := p.iny DIV 2 + p.y;
  158.         DEC(p.d,p.dx); INC(p.y,p.iny);
  159.       END LineStep;
  160.     PROCEDURE Max4(a,b,c,d: LONGINT): LONGINT;
  161.         VAR m: LONGINT;
  162.     BEGIN m := a;
  163.         IF b > m THEN m := b END ;
  164.         IF c > m THEN m := c END ;
  165.         IF d > m THEN m := d END ;
  166.         RETURN m
  167.     END Max4;
  168.     PROCEDURE Min4(a,b,c,d: LONGINT): LONGINT;
  169.         VAR m: LONGINT;
  170.     BEGIN m := a;
  171.         IF b < m THEN m := b END ;
  172.         IF c < m THEN m := c END ;
  173.         IF d < m THEN m := d END ;
  174.         RETURN m
  175.     END Min4;
  176.   BEGIN (* Quadrangle *)
  177.     x1 := P.CX(x1); x2 := P.CX(x2); x3 := P.CX(x3); x4 := P.CX(x4);
  178.     y1 := P.CY(y1); y2 := P.CY(y2); y3 := P.CY(y3); y4 := P.CY(y4);
  179.     IF (Max4(x1, x2, x3, x4) >= P.X) & (Min4(x1, x2, x3, x4) <= P.X + P.W) &
  180.         (Max4(y1, y2, y3, y4) >= P.Y) & (Min4(y1, y2, y3, y4) <= P.Y + P.H) THEN
  181.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  182.       IF (y2>y3) OR (y2=y3) & (x2>x3) THEN x := x2; x2 := x3; x3 := x; y := y2; y2 := y3; y3 := y END;
  183.       IF (y3>y4) OR (y3=y4) & (x3>x4) THEN x := x3; x3 := x4; x4 := x; y := y3; y3 := y4; y4 := y END;
  184.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  185.       IF (y2>y3) OR (y2=y3) & (x2>x3) THEN x := x2; x2 := x3; x3 := x; y := y2; y2 := y3; y3 := y END;
  186.       IF (y1>y2) OR (y1=y2) & (x1>x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  187.       IF LONG(x2-x1)*LONG(y4-y1) > LONG(y2-y1)*LONG(x4-x1) THEN RHS2 := 2 ELSE RHS2 := 0 END;
  188.       IF LONG(x3-x1)*LONG(y4-y1) > LONG(y3-y1)*LONG(x4-x1) THEN RHS3 := 1 ELSE RHS3 := 0 END;
  189.       CASE RHS2 + RHS3 OF
  190.       | 0: InitLineParms(x1,y1,x2,y2,left); InitLineParms(x1,y1,x4,y4,right);
  191.       | 1: InitLineParms(x1,y1,x2,y2,left); InitLineParms(x1,y1,x3,y3,right);
  192.       | 2: InitLineParms(x1,y1,x3,y3,left); InitLineParms(x1,y1,x2,y2,right);
  193.       | 3: InitLineParms(x1,y1,x4,y4,left); InitLineParms(x1,y1,x2,y2,right);
  194.       END;
  195.       WHILE left.y # y2 DO
  196.         LineStep(left); LineStep(right);
  197.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  198.       END;
  199.       CASE RHS2 + RHS3 OF
  200.       | 0: InitLineParms(x2,y2,x3,y3,left);
  201.       | 1: InitLineParms(x2,y2,x4,y4,left);
  202.       | 2: InitLineParms(x2,y2,x4,y4,right);
  203.       | 3: InitLineParms(x2,y2,x3,y3,right);
  204.       END;
  205.       WHILE left.y # y3 DO
  206.         LineStep(left); LineStep(right);
  207.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  208.       END;
  209.       CASE RHS2 + RHS3 OF
  210.       | 0,2: InitLineParms(x3,y3,x4,y4,left);
  211.       | 1,3: InitLineParms(x3,y3,x4,y4,right);
  212.       END;
  213.       WHILE left.y # y4 DO
  214.         LineStep(left); LineStep(right);
  215.         P.FillRect(P.Cx(left.drawX),P.Cy(left.drawY),P.Cx(right.drawX)-P.Cx(left.drawX),P.scale,col,pat,mode)
  216.       END
  217.     END
  218.   END FillQuad;
  219. (* ----------------- display drawing methods ------------------ *)
  220.     PROCEDURE (P: DisplayPort) DrawLine*(x1, y1, x2, y2, col, mode: INTEGER);
  221.     BEGIN Display1.Line(P, col, P.CX(x1), P.CY(y1), P.CX(x2), P.CY(y2), mode)
  222.     END DrawLine;
  223.     PROCEDURE (P: DisplayPort) DrawCircle*(x, y, r, col, mode: INTEGER);
  224.     BEGIN Display1.Circle(P, col, P.CX(x), P.CY(y), r DIV P.scale, mode)
  225.     END DrawCircle;
  226.     PROCEDURE (P: DisplayPort) DrawEllipse*(x, y, a, b, col, mode: INTEGER);
  227.     BEGIN Display1.Ellipse(P, col, P.CX(x), P.CY(y), a DIV P.scale, b DIV P.scale, mode);
  228.     END DrawEllipse;
  229.     PROCEDURE Intersect(F: Port; VAR X, Y, W, H: INTEGER): BOOLEAN;
  230.         VAR t: INTEGER;
  231.     BEGIN
  232.         t := X+W;
  233.         IF F.X > X THEN X := F.X END;
  234.         IF F.X+F.W < t THEN W := F.X+F.W-X ELSE W := t-X END;
  235.         IF W <= 0 THEN RETURN FALSE END;
  236.         t := Y+H;
  237.         IF F.Y > Y THEN Y := F.Y END;
  238.         IF F.Y+F.H < t THEN H := F.Y+F.H-Y ELSE H := t-Y END;
  239.         RETURN H > 0
  240.     END Intersect;
  241.     PROCEDURE (P: DisplayPort) DrawString*(x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  242.         VAR ch: CHAR; pat: LONGINT; X, i, dx, chx, chy, chw, chh, Y, oldX, oldY: INTEGER; fno: SHORTINT;
  243.     BEGIN fno := TextPrinter.FontNo(font);
  244.         X := P.CX(x); y := P.CY(y); ch := s[0]; i := 0;
  245.         WHILE ch # 0X DO
  246.             Display.GetChar(font.raster, ch, dx, chx, chy, chw, chh, pat);
  247.             IF Ceres THEN 
  248.                 X := X + chx; Y := y + chy;
  249.                 IF (X >= P.X) & (X+chw <= P.X + P.W) & (Y >= P.Y) & (Y+chh <= P.Y + P.H) THEN
  250.                     Display.CopyPattern(col, pat, X, Y, mode)
  251.                 ELSE
  252.                     oldX := X; oldY := Y;
  253.                     IF Intersect(P, X, Y, chw, chh) THEN
  254.                         Display.CopyBlock(X, Y, chw, chh, X - oldX, Y - oldY - 200, Display.replace);
  255.                         Display.CopyPattern(col, pat, 0, -200, mode);
  256.                         Display.CopyBlock(X - oldX, Y - oldY - 200, chw, chh, X, Y, Display.replace)
  257.                     END
  258.                 END
  259.             ELSE
  260.                 Display.CopyPatternC(P, col, pat, X+chx, y+chy, mode)
  261.             END ;
  262.             INC(x, SHORT(TextPrinter.DX(fno, ch) DIV 3048));
  263.             X := P.CX(x + P.scale DIV 2); INC(i); ch := s[i]
  264.         END
  265.     END DrawString;
  266.     PROCEDURE (P: DisplayPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  267.         VAR xp, yp: INTEGER;
  268.     BEGIN
  269.         x := P.CX(x); y := P.CY(y); w := w DIV P.scale; h := h DIV P.scale;
  270.         xp := P.CX(0); yp := P.CY(0);
  271.         IF Ceres THEN
  272.             IF Intersect(P, x, y, w, h) THEN 
  273.                 Display.ReplPattern(col, Display1.ThisPattern(pat), x, y, w, h, mode)
  274.             END
  275.         ELSIF pat = 5 THEN (* solid fg *)
  276.             Display.ReplConstC(P, col, x, y, w, h, mode)
  277.         ELSE
  278.             Display.ReplPatternC(P, col, Display1.ThisPattern(pat), x, y, w, h, xp, yp, mode)
  279.         END
  280.     END FillRect;
  281. (* ----------------- printer drawing methods ------------------ *)
  282.     PROCEDURE (P: PrinterPort) DrawLine* (x1, y1, x2, y2, col, mode: INTEGER);
  283.     BEGIN
  284.         x1 := P.CX(x1); y1 := P.CY(y1);
  285.         x2 := P.CX(x2); y2 := P.CY(y2);
  286.         Printer.Line(x1, y1, x2, y2)
  287.     END DrawLine;
  288.     PROCEDURE (P: PrinterPort) DrawCircle* (x, y, r, col, mode: INTEGER);
  289.     BEGIN Printer.Circle(P.CX(x), P.CY(y), r)
  290.     END DrawCircle;
  291.     PROCEDURE (P: PrinterPort) DrawEllipse* (x, y, a, b, col, mode: INTEGER);
  292.     BEGIN Printer.Ellipse(P.CX(x), P.CY(y), a, b)
  293.     END DrawEllipse;
  294.     PROCEDURE (P: PrinterPort) DrawString* (x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  295.     BEGIN
  296.         Printer.String(P.CX(x), P.CY(y), s, font.name)
  297.     END DrawString;
  298.     PROCEDURE (P: PrinterPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  299.     BEGIN
  300.         IF pat = 5 THEN Printer.ReplConst(P.CX(x), P.CY(y), w, h)
  301.         ELSE Printer.ReplPattern(P.CX(x), P.CY(y), w, h, pat)
  302.         END
  303.     END FillRect;
  304. (* ----------------- methods for finding the bounding box------------------ *)
  305.     PROCEDURE MinMax(x, y: INTEGER; VAR min, max: INTEGER);
  306.     BEGIN IF x < y THEN min := x; max := y ELSE min := y; max := x END
  307.     END MinMax;
  308.     PROCEDURE BlowUp (P: Port; x, y, w, h: INTEGER);
  309.     BEGIN x := x + P.x0; y := y + P.y0;
  310.         IF x < P.X THEN P.W := P.W + P.X - x; P.X := x END ;
  311.         IF x + w > P.X + P.W THEN P.W := x + w - P.X END ;
  312.         IF y < P.Y THEN P.H := P.H + P.Y - y; P.Y := y END ;
  313.         IF y + h > P.Y + P.H THEN P.H := y + h - P.Y END
  314.     END BlowUp;
  315.     PROCEDURE (P: BalloonPort) DrawRect* (x, y, w, h, col, mode: INTEGER);
  316.     BEGIN P.DrawRect^(x, y, w, h, col, mode)  (*BlowUp(P, x, y, w, h)*)
  317.     END DrawRect;
  318.     PROCEDURE (P: BalloonPort) DrawLine* (x1, y1, x2, y2, col, mode: INTEGER);
  319.         VAR minx, miny, maxx, maxy: INTEGER;
  320.     BEGIN
  321.         MinMax(x1, x2, minx, maxx);
  322.         MinMax(y1, y2, miny, maxy);
  323.         BlowUp(P, minx, miny, maxx - minx, maxy - miny)
  324.     END DrawLine;
  325.     PROCEDURE (P: BalloonPort) DrawCircle* (x, y, r, col, mode: INTEGER);
  326.     BEGIN BlowUp(P, x - r - 4 , y - r - 4, 2 * r + 4, 2 * r + 4)
  327.     END DrawCircle;
  328.     PROCEDURE (P: BalloonPort) DrawEllipse* (x, y, a, b, col, mode: INTEGER);
  329.     BEGIN BlowUp(P, x - a - 4, y - b - 4, 2 * a + 4, 2 * b + 4)
  330.     END DrawEllipse;
  331.     PROCEDURE StringWidth*(VAR s: ARRAY OF CHAR; f: Fonts.Font): INTEGER;
  332.         VAR fno: SHORTINT; ch: CHAR; dx, w, i, sdx, sx, sy, sw, sh: INTEGER; p: LONGINT;
  333.     BEGIN
  334.         fno := TextPrinter.FontNo(f);
  335.         w := 0; i := 0; ch := s[0];
  336.         WHILE ch # 0X DO
  337.             dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
  338.             INC(w, dx); INC(i); ch := s[i]
  339.         END ;
  340.         IF i > 0 THEN Display.GetChar(f.raster, s[i-1], sdx, sx, sy, sw, sh, p);
  341.             sdx := sdx * 4;
  342.             IF sdx > dx THEN INC(w, sdx - dx) END
  343.         END ;
  344.         RETURN w
  345.     END StringWidth;
  346.     PROCEDURE (P: BalloonPort) DrawString* (x, y: INTEGER; s: ARRAY OF CHAR; font: Fonts.Font; col, mode: INTEGER);
  347.     BEGIN BlowUp(P, x, y+font.minY*4, StringWidth(s, font), font.height*4)
  348.     END DrawString;
  349.     PROCEDURE (P: BalloonPort) FillRect* (x, y, w, h, col, pat, mode: INTEGER);
  350.     BEGIN BlowUp(P, x, y, w, h)
  351.     END FillRect;
  352.     PROCEDURE (P: BalloonPort) FillCircle* (x, y, r, col, pat, mode: INTEGER);
  353.     BEGIN BlowUp(P, x - r - 4 , y - r - 4, 2 * r + 4, 2 * r + 4)
  354.     END FillCircle;
  355.     PROCEDURE (P: BalloonPort) FillQuad* (x1, y1, x2, y2, x3, y3, x4, y4, col, pat, mode: INTEGER);
  356.     BEGIN
  357.         MinMax(x1, x2, x1, x2); MinMax(x2, x3, x2, x3); MinMax(x3, x4, x3, x4);
  358.         MinMax(x2, x3, x2, x3); MinMax(x1, x2, x1, x2);
  359.         MinMax(y1, y2, y1, y2); MinMax(y2, y3, y2, y3); MinMax(y3, y4, y3, y4);
  360.         MinMax(y2, y3, y2, y3); MinMax(y1, y2, y1, y2);
  361.         BlowUp(P, x1, y1, x4 - x1, y4 - y1)
  362.     END FillQuad;
  363.     PROCEDURE InitBalloon*(P: BalloonPort);
  364.     BEGIN P.scale := 1;
  365.         P.X := 10000; P.Y := 10000;
  366.         P.W := -20000; P.H := -20000
  367.     END InitBalloon;
  368. END KeplerPorts.
  369.